home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr14 / maped6.zip / MAPEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-15  |  44KB  |  1,593 lines
  1.  {
  2.   MapEdit 6.0     Wolfenstein Map Editor
  3.  
  4.   ver 6.0 (Dave Huntooon - 5/93)
  5.             - Added help display
  6.                 switches between help display and Bryan Baker's
  7.                 status display
  8.             - Added Copy, Paste and Exchange procedures
  9.             - Added Write and Read procedures that will allow
  10.                 exporting and importing floors via a file named
  11.                 FLOOR.OUT
  12.             - Changed the Clear procedure to fill using the
  13.                 currently selected map value
  14.             - minor fixes
  15.  
  16.   ver 5.0 (Bryan Baker - 4/93)
  17.             - Added display of critical map statistics to edit window:
  18.                 Static Objects
  19.                 Total Guards
  20.                 Doors
  21.  
  22.                 Level 1 Guards
  23.                 Level 3 Guards
  24.                 Level 4 Guards
  25.                 Super   Guards
  26.  
  27.                 Secret Doors
  28.                 Treasure & Extra Lives
  29.  
  30.   ver 4.1a (Dave Huntoon)
  31.             - Adds ability to open Spear of Destiny (SOD) maps.
  32.             - Allows access to objects > 00FE.  Needed for SOD
  33.               objects.
  34.             - minor fix to completely clear text area below
  35.               the map display when the mouse is moved outisde
  36.               of the map area.
  37.  
  38.   ver 4.1  Copyright (c) 1992  Bill Kirby
  39.  
  40.  
  41. }
  42.  
  43. {$A+,B-,D+,E-,F-,I+,L-,N-,O-,R-,S-,V-}
  44. {$M 16384,0,655360}
  45. program mapedit;
  46.  
  47. uses crt,dos,graph,mouse;
  48.  
  49. const MAP_X = 6;
  50.       MAP_Y = 6;
  51.       TEXTLOC = 458;
  52.  
  53.       GAMEPATH     : string = '.\';
  54.       HEADFILENAME : string = 'maphead';
  55.       MAPFILENAME  : string = 'maptemp';
  56.       LEVELS       : word   = 10;
  57.       GAME_VERSION : real   = 1.0;
  58.  
  59.       VERSION      : string = '6.0';
  60.  
  61. type data_block = record
  62.        size : word;
  63.        data : pointer;
  64.      end;
  65.  
  66.      level_type = record
  67.        map,
  68.        objects,
  69.        other           : data_block;
  70.        width,
  71.        height          : word;
  72.        name            : string[16];
  73.      end;
  74.  
  75.      grid = array[0..63,0..63] of word;
  76.  
  77.      filltype = (solid,check);
  78.      doortype = (horiz,vert);
  79.  
  80.  
  81. var levelmap,
  82.     objectmap    : grid;
  83.     maps         : array[1..60] of level_type;
  84.  
  85.     show_objects,
  86.     show_floor   : boolean;
  87.  
  88.     mapgraph,
  89.     objgraph     : array[0..511] of string[4];
  90.     mapnames,
  91.     objnames     : array[0..511] of string[20];
  92.  
  93.     themouse     : resetrec;
  94.     mouseloc     : locrec;
  95.  
  96.     stats,
  97.     xfer,
  98.     copy,
  99.     excng        : boolean;
  100.     tempobj,
  101.     tempmap      : grid;
  102.  
  103. procedure waitforkey;
  104. var key: char;
  105. begin
  106.   repeat until keypressed;
  107.   key:= readkey;
  108.   if key=#0 then key:= readkey;
  109. end;
  110.  
  111. procedure getkey(var key: char; var control: boolean);
  112. begin
  113.   control:= false;
  114.   key:= readkey;
  115.   if key=#0 then
  116.     begin
  117.       control:= true;
  118.       key:= readkey;
  119.     end;
  120. end;
  121.  
  122. procedure decorate(x,y,c: integer);
  123. var i,j: integer;
  124. begin
  125.   setfillstyle(1,c);
  126.   bar(x*7+MAP_X+2,y*7+MAP_Y+2,x*7+MAP_X+4,y*7+MAP_Y+4);
  127. end;
  128.  
  129. procedure box(fill: filltype; x,y,c1,c2: integer; dec: boolean);
  130. begin
  131.   if fill=solid then
  132.     setfillstyle(1,c1)
  133.   else
  134.     setfillstyle(9,c1);
  135.  
  136.   bar(x*7+MAP_X,y*7+MAP_Y,x*7+6+MAP_X,y*7+6+MAP_Y);
  137.   if dec then decorate(x,y,c2);
  138. end;
  139.  
  140. procedure outtext(x,y,color: integer; s: string);
  141. begin
  142.   setcolor(color);
  143.   outtextxy(x*7+MAP_X,y*7+MAP_Y,s);
  144. end;
  145.  
  146. function hex(x: word): string;
  147. const digit : string[16] = '0123456789ABCDEF';
  148. var temp : string[4];
  149.     i    : integer;
  150. begin
  151.   temp:= '    ';
  152.   for i:= 4 downto 1 do
  153.     begin
  154.       temp[i]:= digit[(x and $000f)+1];
  155.       x:= x div 16;
  156.     end;
  157.   hex:= temp;
  158. end;
  159.  
  160. function hexbyte(x: byte): string;
  161. const digit : string[16] = '0123456789ABCDEF';
  162. var temp : string[4];
  163.     i    : integer;
  164. begin
  165.   temp:= '  ';
  166.   for i:= 2 downto 1 do
  167.     begin
  168.       temp[i]:= digit[(x and $000f)+1];
  169.       x:= x div 16;
  170.     end;
  171.   hexbyte:= temp;
  172. end;
  173.  
  174. procedure doline(x,y,x2,y2: integer);
  175. begin
  176.   line(x+MAP_X,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  177. end;
  178.  
  179. procedure dobar(x,y,x2,y2: integer);
  180. begin
  181.   bar(x+MAP_Y,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  182. end;
  183.  
  184. procedure circle(x,y,c1,c2: integer);
  185. const sprite : array[0..6,0..6] of byte =
  186.                    ((0,0,1,1,1,0,0),
  187.                     (0,1,1,1,1,1,0),
  188.                     (1,1,1,2,1,1,1),
  189.                     (1,1,2,2,2,1,1),
  190.                     (1,1,1,2,1,1,1),
  191.                     (0,1,1,1,1,1,0),
  192.                     (0,0,1,1,1,0,0));
  193. var i,j,c: integer;
  194. begin
  195.   for i:= 0 to 6 do
  196.     for j:= 0 to 6 do
  197.       begin
  198.         case sprite[i,j] of
  199.           0: c:=0;
  200.           1: c:=c1;
  201.           2: c:=c2;
  202.         end;
  203.         putpixel(x*7+MAP_X+i,y*7+MAP_Y+j,c);
  204.       end;
  205. end;
  206.  
  207. procedure door(dtype: doortype; x,y,color: integer);
  208. begin
  209.   case dtype of
  210.     vert: begin
  211.             setfillstyle(1,color);
  212.             dobar(x*7+2,y*7,x*7+4,y*7+6);
  213.           end;
  214.     horiz : begin
  215.               setfillstyle(1,color);
  216.               dobar(x*7,y*7+2,x*7+6,y*7+4);
  217.           end;
  218.   end;
  219. end;
  220.  
  221. function hexnibble(c: char): byte;
  222. begin
  223.   case c of
  224.     '0'..'9': hexnibble:= ord(c)-ord('0');
  225.     'a'..'f': hexnibble:= ord(c)-ord('a')+10;
  226.     'A'..'F': hexnibble:= ord(c)-ord('A')+10;
  227.     else hexnibble:= 0;
  228.   end;
  229. end;
  230.  
  231. procedure output(x,y: integer; data: string);
  232. var size  : integer;
  233.     temp  : string[4];
  234.     c1,c2 : byte;
  235. begin
  236.   if data<>'0000' then
  237.     begin
  238.       temp:= data;
  239.       c1:= hexnibble(temp[1]);
  240.       c2:= hexnibble(temp[2]);
  241.       case temp[3] of
  242.         '0': outtext(x,y,c1,temp[4]);
  243.         '1': box(solid,x,y,c1,c2,false);
  244.         '2': box(check,x,y,c1,c2,false);
  245.         '3': box(solid,x,y,c1,c2,true);
  246.         '4': box(check,x,y,c1,c2,true);
  247.         '5': circle(x,y,c1,c2);
  248.         '6': door(horiz,x,y,c1);
  249.         '7': door(vert,x,y,c1);
  250.         '8': begin
  251.                setfillstyle(1,c1);
  252.                dobar(x*7,y*7,x*7+6,y*7+3);
  253.                setfillstyle(1,c2);
  254.                dobar(x*7,y*7+4,x*7+6,y*7+6);
  255.               end;
  256.         '9': putpixel(x*7+MAP_X+3,y*7+MAP_Y+3,c1);
  257.         'a': begin setfillstyle(1,c1); dobar(x*7+2,y*7+1,x*7+4,y*7+5); end;
  258.         'b': begin setfillstyle(1,c1); dobar(x*7+2,y*7+2,x*7+4,y*7+4); end;
  259.         'c': begin setfillstyle(1,c1); dobar(x*7+1,y*7+1,x*7+5,y*7+5); end;
  260.         'd': begin
  261.                setcolor(c1);
  262.                doline(x*7+1,y*7+1,x*7+5,y*7+5);
  263.                doline(x*7+5,y*7+1,x*7+1,y*7+5);
  264.              end;
  265.         'e': begin
  266.                setcolor(c1);
  267.                rectangle(x*7+MAP_X,y*7+MAP_Y,x*7+MAP_X+6,y*7+MAP_Y+6);
  268.              end;
  269.         'f': case c2 of
  270.               2: begin {east}
  271.                    setcolor(c1);
  272.                    doline(x*7,y*7+3,x*7+6,y*7+3);
  273.                    doline(x*7+6,y*7+3,x*7+3,y*7);
  274.                    doline(x*7+6,y*7+3,x*7+3,y*7+6);
  275.                 end;
  276.               0: begin {north}
  277.                    setcolor(c1);
  278.                    doline(x*7+3,y*7+6,x*7+3,y*7);
  279.                    doline(x*7+3,y*7,x*7,y*7+3);
  280.                    doline(x*7+3,y*7,x*7+6,y*7+3);
  281.                  end;
  282.               6: begin {west}
  283.                    setcolor(c1);
  284.                    doline(x*7+6,y*7+3,x*7,y*7+3);
  285.                    doline(x*7,y*7+3,x*7+3,y*7);
  286.                    doline(x*7,y*7+3,x*7+3,y*7+6);
  287.                  end;
  288.               4: begin {south}
  289.                    setcolor(c1);
  290.                    doline(x*7+3,y*7,x*7+3,y*7+6);
  291.                    doline(x*7+3,y*7+6,x*7,y*7+3);
  292.                    doline(x*7+3,y*7+6,x*7+6,y*7+3);
  293.                  end;
  294.               1: begin {northeast}
  295.                    setcolor(c1);
  296.                    doline(x*7,y*7+6,x*7+6,y*7);
  297.                    doline(x*7+6,y*7,x*7+3,y*7);
  298.                    doline(x*7+6,y*7,x*7+6,y*7+3);
  299.                  end;
  300.               7: begin {northwest}
  301.                    setcolor(c1);
  302.                    doline(x*7+6,y*7+6,x*7,y*7);
  303.                    doline(x*7,y*7,x*7+3,y*7);
  304.                    doline(x*7,y*7,x*7,y*7+3);
  305.                  end;
  306.               3: begin {southeast}
  307.                    setcolor(c1);
  308.                    doline(x*7,y*7,x*7+6,y*7+6);
  309.                    doline(x*7+6,y*7+6,x*7+3,y*7+6);
  310.                    doline(x*7+6,y*7+6,x*7+6,y*7+3);
  311.                  end;
  312.               5: begin {southwest}
  313.                    setcolor(c1);
  314.                    doline(x*7+6,y*7,x*7,y*7+6);
  315.                    doline(x*7,y*7+6,x*7+3,y*7+6);
  316.                    doline(x*7,y*7+6,x*7,y*7+3);
  317.                  end;
  318.  
  319.              end;
  320.       end;
  321.     end;
  322. end;
  323.  
  324. procedure display_map;
  325. var i,j: integer;
  326. begin
  327.   j:= 63;
  328.   i:= 0;
  329.   repeat
  330.     setfillstyle(1,0);
  331.     dobar(i*7,j*7,i*7+6,j*7+6);
  332.     if show_floor then
  333.       output(i,j,mapgraph[levelmap[i,j]])
  334.     else
  335.       if not (levelmap[i,j] in [$6a..$8f]) then
  336.         output(i,j,mapgraph[levelmap[i,j]]);
  337.     if show_objects then
  338.       output(i,j,objgraph[objectmap[i,j]]);
  339.     inc(i);
  340.     if i=64 then
  341.       begin
  342.         i:= 0;
  343.         dec(j);
  344.       end;
  345.   until (j<0) or keypressed;
  346. end;
  347.  
  348. procedure read_levels;
  349. var headfile,
  350.     mapfile  : file;
  351.     s,o,
  352.     size     : word;
  353.     idsig    : string[4];
  354.     level    : integer;
  355.     levelptr : longint;
  356.     tempstr  : string[16];
  357.     map_pointer,
  358.     object_pointer,
  359.     other_pointer    : longint;
  360.  
  361. begin
  362.   idsig:= '    ';
  363.   tempstr:= '                ';
  364.   assign(headfile,GAMEPATH+HEADFILENAME);
  365.   {$I-}
  366.   reset(headfile,1);
  367.   {$I+}
  368.   if ioresult<>0 then
  369.     begin
  370.       writeln('error opening ',HEADFILENAME);
  371.       halt(1);
  372.     end;
  373.   assign(mapfile,GAMEPATH+MAPFILENAME);
  374.   {$I-}
  375.   reset(mapfile,1);
  376.   {$I+}
  377.   if ioresult<>0 then
  378.     begin
  379.       writeln('error opening ',MAPFILENAME);
  380.       halt(1);
  381.     end;
  382.  
  383.   for level:= 1 to LEVELS do
  384.     begin
  385.       seek(headfile,2+(level-1)*4);
  386.       blockread(headfile,levelptr,4);
  387.       seek(mapfile,levelptr);
  388.       with maps[level] do
  389.         begin
  390.           blockread(mapfile,map_pointer,4);
  391.           blockread(mapfile,object_pointer,4);
  392.           blockread(mapfile,other_pointer,4);
  393.           blockread(mapfile,map.size,2);
  394.           blockread(mapfile,objects.size,2);
  395.           blockread(mapfile,other.size,2);
  396.           blockread(mapfile,width,2);
  397.           blockread(mapfile,height,2);
  398.           name[0]:=#16;
  399.           blockread(mapfile,name[1],16);
  400.           if GAME_VERSION = 1.1 then
  401.             blockread(mapfile,idsig[1],4);
  402.  
  403.           seek(mapfile,map_pointer);
  404.           getmem(map.data,map.size);
  405.           s:= seg(map.data^);
  406.           o:= ofs(map.data^);
  407.           blockread(mapfile,mem[s:o],map.size);
  408.  
  409.           seek(mapfile,object_pointer);
  410.           getmem(objects.data,objects.size);
  411.           s:= seg(objects.data^);
  412.           o:= ofs(objects.data^);
  413.           blockread(mapfile,mem[s:o],objects.size);
  414.  
  415.           seek(mapfile,other_pointer);
  416.           getmem(other.data,other.size);
  417.           s:= seg(other.data^);
  418.           o:= ofs(other.data^);
  419.           blockread(mapfile,mem[s:o],other.size);
  420.           if GAME_VERSION = 1.0 then
  421.             blockread(mapfile,idsig[1],4);
  422.         end;
  423.     end;
  424.   close(mapfile);
  425.   close(headfile);
  426. end;
  427.  
  428. procedure write_levels;
  429. var headfile,
  430.     mapfile    : file;
  431.     abcd,
  432.     s,o,
  433.     size     : word;
  434.     idsig    : string[4];
  435.     level    : integer;
  436.     levelptr : longint;
  437.     tempstr  : string[16];
  438.     map_pointer,
  439.     object_pointer,
  440.     other_pointer    : longint;
  441.  
  442. begin
  443.   abcd:= $abcd;
  444.   idsig:= '!ID!';
  445.   tempstr:= 'TED5v1.0';
  446.   assign(headfile,GAMEPATH+HEADFILENAME);
  447.   rewrite(headfile,1);
  448.   assign(mapfile,GAMEPATH+MAPFILENAME);
  449.   rewrite(mapfile,1);
  450.  
  451.   blockwrite(headfile,abcd,2);
  452.   blockwrite(mapfile,tempstr[1],8);
  453.   levelptr:= 8;
  454.  
  455.   for level:= 1 to LEVELS do
  456.     begin
  457.       with maps[level] do
  458.         begin
  459.           if GAME_VERSION = 1.1 then
  460.             begin
  461.               map_pointer:= levelptr;
  462.               s:= seg(map.data^);
  463.               o:= ofs(map.data^);
  464.               blockwrite(mapfile,mem[s:o],map.size);
  465.               inc(levelptr,map.size);
  466.  
  467.               object_pointer:= levelptr;
  468.               s:= seg(objects.data^);
  469.               o:= ofs(objects.data^);
  470.               blockwrite(mapfile,mem[s:o],objects.size);
  471.               inc(levelptr,objects.size);
  472.  
  473.               other_pointer:= levelptr;
  474.               s:= seg(other.data^);
  475.               o:= ofs(other.data^);
  476.               blockwrite(mapfile,mem[s:o],other.size);
  477.               inc(levelptr,other.size);
  478.  
  479.               blockwrite(headfile,levelptr,4);
  480.  
  481.               blockwrite(mapfile,map_pointer,4);
  482.               blockwrite(mapfile,object_pointer,4);
  483.               blockwrite(mapfile,other_pointer,4);
  484.               blockwrite(mapfile,map.size,2);
  485.               blockwrite(mapfile,objects.size,2);
  486.               blockwrite(mapfile,other.size,2);
  487.               blockwrite(mapfile,width,2);
  488.               blockwrite(mapfile,height,2);
  489.               name[0]:=#16;
  490.               blockwrite(mapfile,name[1],16);
  491.               inc(levelptr,38);
  492.             end
  493.           else
  494.             begin
  495.               blockwrite(headfile,levelptr,4);
  496.               map_pointer:= levelptr+38;
  497.               object_pointer:= map_pointer+map.size;
  498.               other_pointer:= object_pointer+objects.size;
  499.  
  500.               blockwrite(mapfile,map_pointer,4);
  501.               blockwrite(mapfile,object_pointer,4);
  502.               blockwrite(mapfile,other_pointer,4);
  503.               blockwrite(mapfile,map.size,2);
  504.               blockwrite(mapfile,objects.size,2);
  505.               blockwrite(mapfile,other.size,2);
  506.               blockwrite(mapfile,width,2);
  507.               blockwrite(mapfile,height,2);
  508.               name[0]:=#16;
  509.               blockwrite(mapfile,name[1],16);
  510.  
  511.               s:= seg(map.data^);
  512.               o:= ofs(map.data^);
  513.               blockwrite(mapfile,mem[s:o],map.size);
  514.               s:= seg(objects.data^);
  515.               o:= ofs(objects.data^);
  516.               blockwrite(mapfile,mem[s:o],objects.size);
  517.               s:= seg(other.data^);
  518.               o:= ofs(other.data^);
  519.               blockwrite(mapfile,mem[s:o],other.size);
  520.               inc(levelptr,map.size+objects.size+other.size+38);
  521.             end;
  522.           blockwrite(mapfile,idsig[1],4);
  523.           inc(levelptr,4);
  524.         end;
  525.     end;
  526.   close(mapfile);
  527.   close(headfile);
  528. end;
  529.  
  530. procedure a7a8_expand(src: data_block; var dest: data_block);
  531. var s,o,
  532.     s2,o2,
  533.     index,
  534.     index2,
  535.     size,
  536.     length,
  537.     data,
  538.     newsize  : word;
  539.     goback1  : byte;
  540.     goback2  : word;
  541.     i        : integer;
  542.  
  543. begin
  544.   s:=seg(src.data^);
  545.   o:=ofs(src.data^);
  546.   index:=0;
  547.   move(mem[s:o+index],dest.size,2); inc(index,2);
  548.   getmem(dest.data,dest.size);
  549.   s2:=seg(dest.data^);
  550.   o2:=ofs(dest.data^);
  551.   index2:=0;
  552.  
  553.   repeat
  554.     move(mem[s:o+index],data,2); inc(index,2);
  555.     case hi(data) of
  556.       $a7: begin
  557.              length:=lo(data);
  558.              move(mem[s:o+index],goback1,1); inc(index,1);
  559.              move(mem[s2:o2+index2-goback1*2],mem[s2:o2+index2],length*2);
  560.              inc(index2,length*2);
  561.            end;
  562.       $a8: begin
  563.              length:=lo(data);
  564.              move(mem[s:o+index],goback2,2); inc(index,2);
  565.              move(mem[s2:o2+goback2*2],mem[s2:o2+index2],length*2);
  566.              inc(index2,length*2);
  567.            end;
  568.       else begin
  569.              move(data,mem[s2:o2+index2],2);
  570.              inc(index2,2);
  571.            end;
  572.     end;
  573.   until index=src.size;
  574. end;
  575.  
  576. procedure expand(d: data_block; var g: grid);
  577. var i,x,y : integer;
  578.     s,o,
  579.     data,
  580.     count : word;
  581.     temp  : data_block;
  582. begin
  583.   if GAME_VERSION = 1.1 then
  584.     a7a8_expand(d,temp)
  585.   else
  586.     temp:=d;
  587.  
  588.   x:= 0;
  589.   y:= 0;
  590.   s:= seg(temp.data^);
  591.   o:= ofs(temp.data^);
  592.   inc(o,2);
  593.   while (y<64) do
  594.     begin
  595.       move(mem[s:o],data,2); inc(o,2);
  596.       if data=$abcd then
  597.         begin
  598.           move(mem[s:o],count,2); inc(o,2);
  599.           move(mem[s:o],data,2); inc(o,2);
  600.           for i:= 1 to count do
  601.             begin
  602.               g[x,y]:= data;
  603.               inc(x);
  604.               if x=64 then
  605.                 begin
  606.                   x:= 0;
  607.                   inc(y);
  608.                 end;
  609.             end;
  610.         end
  611.       else
  612.         begin
  613.           g[x,y]:= data;
  614.           inc(x);
  615.           if x=64 then
  616.             begin
  617.               x:= 0;
  618.               inc(y);
  619.             end;
  620.         end;
  621.     end;
  622.   if GAME_VERSION=1.1 then
  623.     freemem(temp.data,temp.size);
  624. end;
  625.  
  626. procedure compress(g: grid; var d: data_block);
  627. var temp     : pointer;
  628.     size: word;
  629.     abcd,
  630.     s,o,
  631.     olddata,
  632.     data,
  633.     nextdata,
  634.     count    : word;
  635.     x,y,i    : integer;
  636.     temp2    : pointer;
  637.  
  638. begin
  639.   abcd:= $abcd;
  640.   x:= 0;
  641.   y:= 0;
  642.   getmem(temp,8194);
  643.   s:= seg(temp^);
  644.   o:= ofs(temp^);
  645.   data:= $2000;
  646.   move(data,mem[s:o],2);
  647.  
  648.   size:= 2;
  649.   data:= g[0,0];
  650.   while (y<64) do
  651.     begin
  652.       count:= 1;
  653.       repeat
  654.         inc(x);
  655.         if x=64 then
  656.           begin
  657.             x:=0;
  658.             inc(y);
  659.           end;
  660.         if y<64 then
  661.           nextdata:= g[x,y];
  662.         inc(count);
  663.       until (nextdata<>data) or (y=64);
  664.       dec(count);
  665.       if count<3 then
  666.         begin
  667.           for i:= 1 to count do
  668.             begin
  669.               move(data,mem[s:o+size],2);
  670.               inc(size,2);
  671.             end;
  672.         end
  673.       else
  674.         begin
  675.           move(abcd,mem[s:o+size],2);
  676.           inc(size,2);
  677.           move(count,mem[s:o+size],2);
  678.           inc(size,2);
  679.           move(data,mem[s:o+size],2);
  680.           inc(size,2);
  681.         end;
  682.       data:= nextdata;
  683.     end;
  684.   getmem(temp2,size);
  685.   move(temp^,temp2^,size);
  686.   freemem(temp,8194);
  687.   if GAME_VERSION = 1.1 then
  688.     begin
  689.       getmem(temp,size+2);
  690.       s:= seg(temp^);
  691.       o:= ofs(temp^);
  692.       move(size,mem[s:o],2);
  693.       move(temp2^,mem[s:o+2],size);
  694.       d.data:=temp;
  695.       d.size:= size+2;
  696.       freemem(temp2,size);
  697.     end
  698.   else
  699.     begin
  700.       d.data:= temp2;
  701.       d.size:= size;
  702.     end;
  703. end;
  704.  
  705.  
  706.  
  707. procedure copy_level; { DGH 5/93 }
  708.  
  709. var   i, j     : integer;
  710.  
  711. begin
  712.    tempobj := objectmap;
  713.    tempmap := levelmap;
  714. end;
  715.  
  716.  
  717. procedure paste_level; { DGH 5/93 }
  718.  
  719. var   i, j     : integer;
  720.  
  721. begin
  722.        objectmap := tempobj;
  723.        levelmap  := tempmap;
  724. end;
  725.  
  726.  
  727. procedure exchange; { DGH 5/93 }
  728.  
  729. var   i, j      : integer;
  730.       tempobj1,
  731.       tempmap1  : word;
  732.  
  733. begin
  734.    for i:=0 to 63 do
  735.     for j:=0 to 63 do
  736.       begin
  737.          tempobj1  := objectmap[i,j];
  738.          tempmap1  := levelmap[i,j];
  739.          objectmap[i,j] := tempobj[i,j];
  740.          levelmap[i,j]  := tempmap[i,j];
  741.          tempobj[i,j]   := tempobj1;
  742.          tempmap[i,j]   := tempmap1;
  743.       end;
  744.  
  745. end;
  746.  
  747.  
  748. procedure print_help;   {DGH 5/93 }
  749.  
  750. var   StartX   : integer;
  751.       StartY   : integer;
  752.       DeltaY   : integer;
  753.  
  754. begin
  755.    StartX := 462+MAP_X;
  756.    StartY := 380+MAP_Y;
  757.    DeltaY := 9;
  758.  
  759.    setcolor(15);
  760.    setfillstyle(1,0);
  761.    bar(StartX, StartY, 639, 479);
  762.    outtextxy(StartX, StartY,'O = Toggle Objects');
  763.    StartY := StartY + DeltaY;
  764.    outtextxy(StartX, StartY,'F = Toggle Floor');
  765.    StartY := StartY + DeltaY;
  766.    outtextxy(StartX, StartY,'C = Clear Floor');
  767.    StartY := StartY + DeltaY;
  768.    outtextxy(StartX, StartY,'S = Toggle Stats/Help');
  769.    StartY := StartY + DeltaY;
  770.    if copy then setcolor(14) else setcolor(15);
  771.    outtextxy(StartX, StartY,'M = Memorize Level');
  772.    StartY := StartY + DeltaY;
  773.    if (excng and copy) then setcolor(14);
  774.    if (excng and not copy) then setcolor (12);
  775.    if not excng then setcolor(15);
  776.    outtextxy(StartX, StartY,'E = Exchange Level');
  777.    setcolor(15);
  778.    if (not copy and xfer) then setcolor(12);
  779.    if (copy and xfer) then setcolor(14);
  780.    StartY := StartY + DeltaY;
  781.    outtextxy(StartX, StartY,'T = Transfer Level');
  782.    setcolor(15);
  783.    StartY := StartY + DeltaY;
  784.    outtextxy(startx, starty, 'R = Read Floor.out');
  785.    StartY := StartY + DeltaY;
  786.    outtextxy(startx, starty, 'W = Write Floor.out');
  787.    StartY := StartY + DeltaY;
  788.    outtextxy(StartX, StartY,'Q = Quit');
  789.    delay(200);
  790. end;
  791.  
  792.  
  793. procedure print_version; { DGH 5/93 }
  794.  
  795. begin
  796.   setfillstyle(1,0);
  797.   bar(180,TEXTLOC,461,479);
  798.   setcolor(12);
  799.   outtextxy(188,TEXTLOC,'Mapedit v'+VERSION);
  800. end;
  801.  
  802.  
  803.  
  804. procedure error_read; { DGH 5/93 }
  805.  
  806. begin
  807.   setfillstyle(1,0);
  808.   bar(180,TEXTLOC,461,479);
  809.   setcolor(15);
  810.   outtextxy(180,TEXTLOC,'ERROR Reading FLOOR.OUT');
  811.   delay(1000);
  812. end;
  813.  
  814.  
  815. procedure error_write; { DGH 5/93 }
  816.  
  817. begin
  818.   setfillstyle(1,0);
  819.   bar(180,TEXTLOC,461,479);
  820.   setcolor(15);
  821.   outtextxy(180,TEXTLOC,'ERROR Writing FLOOR.OUT');
  822.   delay(1000);
  823. end;
  824.  
  825.  
  826. procedure read_floor; { DGH 5/93 }
  827.  
  828. var i, j       : integer;
  829.     floor_file : file;
  830.     floor_name : string;
  831.     numread1   : word;
  832.     numread2   : word;
  833.     size       : word;
  834.  
  835. begin
  836.   size := sizeof(tempmap);
  837.   floor_name := 'FLOOR.OUT';
  838.   Assign(floor_file, floor_name); {Open FIle}
  839. {$I-}
  840.   reset(floor_file,1);
  841. {$I+}
  842.   if ioresult <> 0 then
  843.     begin
  844.       error_read;
  845.     end else
  846.     begin
  847.       blockread(floor_file,tempmap,sizeof(tempmap),numread1);
  848.       blockread(floor_file,tempobj,sizeof(tempmap),numread2);
  849.       if (numread1 <> size) or (numread2 <> size) then error_read else
  850.        begin
  851.         copy := true;
  852.         print_help;
  853.        end;
  854.       close(floor_file);
  855.     end;
  856. end;
  857.  
  858.  
  859. procedure write_floor; { DGH 5/93 }
  860.  
  861. var i, j       : integer;
  862.     floor_file : file;
  863.     floor_name : string;
  864.     numwrite1  : word;
  865.     numwrite2  : word;
  866.     size       : word;
  867.  
  868. begin
  869.   floor_name := 'FLOOR.OUT';
  870.   size := sizeof(tempmap);
  871.   Assign(floor_file, floor_name); {Open FIle}
  872. {$I-}
  873.   rewrite(floor_file,1);
  874. {$I+}
  875.   if ioresult <> 0 then
  876.   begin
  877.     error_write;
  878.   end else
  879.   blockwrite(floor_file,levelmap,sizeof(levelmap),numwrite1);
  880.   blockwrite(floor_file,objectmap,sizeof(objectmap),numwrite2);
  881.   if (numwrite1 <> size) or (numwrite2 <> size) then error_write;
  882.   close(floor_file);
  883. end;
  884.  
  885.  
  886.  
  887. procedure print_stats;       { BDB 4/93 }
  888. var   i, j     : integer;
  889.       Tempstr  : string;
  890.       Statics  : integer;
  891.       L1Guards : integer;
  892.       L3Guards : integer;
  893.       L4Guards : integer;
  894.       SGuards  : integer;
  895.       TGuards  : integer;
  896.       Treasure : integer;
  897.       Doors    : integer;
  898.       SecDoors : integer;
  899.       StartX   : integer;
  900.       StartY   : integer;
  901.       DeltaY   : integer;
  902. begin
  903.  if stats then
  904.   begin
  905.    Statics  := 0;
  906.    L1Guards := 0;
  907.    L3Guards := 0;
  908.    L4Guards := 0;
  909.    SGuards  := 0;
  910.    TGuards  := 0;
  911.    Treasure := 0;
  912.    Doors    := 0;
  913.    SecDoors := 0;
  914.    StartX   := 462+MAP_X;
  915.    StartY   := 380+MAP_Y;
  916.    DeltaY   := 9;
  917.  
  918.    for i:=0 to 63 do
  919.     for j:=0 to 63 do
  920.       begin
  921.        if objectmap[i,j] in [$17..$4a]   then Statics  := Statics  + 1;
  922.        if objectmap[i,j] in [$6c..$7c]   then L1Guards := L1Guards + 1;
  923.        if objectmap[i,j] in [$7e..$85]   then L1Guards := L1Guards + 1;
  924.        if objectmap[i,j] in [$8a..$8d]   then L1Guards := L1Guards + 1;
  925.        if objectmap[i,j] in [$d8..$df]   then L1Guards := L1Guards + 1;
  926.        if objectmap[i,j] in [$90..$9f]   then L3Guards := L3Guards + 1;
  927.        if objectmap[i,j] in [$a2..$a9]   then L3Guards := L3Guards + 1;
  928.        if objectmap[i,j] in [$ae..$b1]   then L3Guards := L3Guards + 1;
  929.        if objectmap[i,j] in [$ea..$f1]   then L3Guards := L3Guards + 1;
  930.        if objectmap[i,j] in [$b4..$c3]   then L4Guards := L4Guards + 1;
  931.        if objectmap[i,j] in [$c6..$cd]   then L4Guards := L4Guards + 1;
  932.        if objectmap[i,j] in [$d2..$d5]   then L4Guards := L4Guards + 1;
  933.        if (objectmap[i,j]>$fc) and (objectmap[i,j]<$104)
  934.                                          then L4Guards := L4Guards + 1;
  935.        if objectmap[i,j] in [$c4..$c5]   then SGuards  := SGuards + 1;
  936.        if objectmap[i,j] in [$d6..$d7]   then SGuards  := SGuards + 1;
  937.        if objectmap[i,j] in [$e0..$e3]   then SGuards  := SGuards + 1;
  938.        if objectmap[i,j] in [$6a..$6b]   then SGuards  := SGuards + 1;
  939.        if objectmap[i,j] in [$8e..$8f]   then SGuards  := SGuards + 1;
  940.        if objectmap[i,j] in [$a0..$a1]   then SGuards  := SGuards + 1;
  941.        if objectmap[i,j] in [$b2..$b3]   then SGuards  := SGuards + 1;
  942.        if objectmap[i,j] = $7d           then SGuards  := SGuards + 1;
  943.        if objectmap[i,j] in [$34..$38]   then Treasure := Treasure + 1;
  944.        if objectmap[i,j] = $62           then SecDoors := SecDoors + 1;
  945.        if levelmap[i, j] in [$5a..$5f]   then Doors    := Doors    + 1;
  946.        if levelmap[i, j] in [$64..$65]   then Doors    := Doors    + 1;
  947.       end;
  948.   TGuards := L1Guards + L3Guards + L4Guards + SGuards;
  949.   setcolor(15);
  950.   setfillstyle(1,0);
  951.   bar(StartX, StartY, 639, 479);
  952.  
  953.   if Statics<400 then setcolor(15) else setcolor(12);
  954.   str(Statics:4, Tempstr);
  955.   outtextxy(StartX, StartY,Tempstr+'  Static Objects');
  956.  
  957.   if TGuards<150 then setcolor(15) else setcolor(12);
  958.   StartY := StartY + DeltaY;
  959.   str(TGuards:4, Tempstr);
  960.   outtextxy(StartX, StartY,Tempstr+'  Total Guards  ');
  961.  
  962.   if Doors<65 then setcolor(15) else setcolor(12);
  963.   StartY := StartY + DeltaY;
  964.   str(Doors:4, Tempstr);
  965.   outtextxy(StartX, StartY,Tempstr+'  Doors         ');
  966.  
  967.   setcolor(7);
  968.   StartY := StartY + DeltaY + 4;
  969.   str(L1Guards:4, Tempstr);
  970.   outtextxy(StartX, StartY,Tempstr+'  Level 1 Guards');
  971.  
  972.   StartY := StartY + DeltaY;
  973.   str(L3Guards:4, Tempstr);
  974.   outtextxy(StartX, StartY,Tempstr+'  Level 3 Guards');
  975.  
  976.   StartY := StartY + DeltaY;
  977.   str(L4Guards:4, Tempstr);
  978.   outtextxy(StartX, StartY,Tempstr+'  Level 4 Guards');
  979.  
  980.   StartY := StartY + DeltaY;
  981.   str(SGuards:4, Tempstr);
  982.   outtextxy(StartX, StartY,Tempstr+'  Super   Guards');
  983.  
  984.   StartY := StartY + DeltaY + 4;
  985.   str(SecDoors:4, Tempstr);
  986.   outtextxy(StartX, StartY,Tempstr+'  Secret Doors  ');
  987.  
  988.   StartY := StartY + DeltaY;
  989.   str(Treasure:4, Tempstr);
  990.   outtextxy(StartX, StartY,Tempstr+'  $$$ / One-ups ');
  991.  end;
  992. end;
  993.  
  994.  
  995. procedure clear_level(n: integer);
  996. var x,y: integer;
  997. begin
  998.    mhide;
  999.    for x:= 0 to 63 do
  1000.      for y:= 0 to 63 do
  1001.        begin
  1002.          levelmap[x,y]:= n;
  1003.          objectmap[x,y]:= 0;
  1004.        end;
  1005.    for x:= 0 to 63 do
  1006.      begin
  1007.        levelmap[x,0]:= 1;
  1008.        levelmap[x,63]:= 1;
  1009.        levelmap[0,x]:= 1;
  1010.        levelmap[63,x]:= 1;
  1011.      end;
  1012.    display_map;
  1013.    print_stats;
  1014.    mshow;
  1015. end;
  1016.  
  1017. function str_to_hex(s: string): word;
  1018. var temp : word;
  1019.     i    : integer;
  1020. begin
  1021.   temp:= 0;
  1022.   for i:= 1 to length(s) do
  1023.     begin
  1024.       temp:= temp * 16;
  1025.       case s[i] of
  1026.         '0'..'9': temp:= temp + ord(s[i])-ord('0');
  1027.         'a'..'f': temp:= temp + ord(s[i])-ord('a')+10;
  1028.         'A'..'F': temp:= temp + ord(s[i])-ord('A')+10;
  1029.       end;
  1030.     end;
  1031.   str_to_hex:= temp;
  1032. end;
  1033.  
  1034. procedure showlegend(which,start,n: integer);
  1035. var i,x,y: integer;
  1036.     save: boolean;
  1037. begin
  1038.   mhide;
  1039.   save:= show_objects;
  1040.   show_objects:= true;
  1041.   setfillstyle(1,0);
  1042.   bar(64*7+MAP_X+13,4,639-5,380-30);
  1043.   x:= 66;
  1044.   y:= 0;
  1045.   for i:= start to start+n-1 do
  1046.     begin
  1047.       if which=0 then
  1048.         begin
  1049.           output(x,y,mapgraph[i]);
  1050.           outtext(x+2,y,15,mapnames[i]);
  1051.         end
  1052.       else
  1053.         begin
  1054.           output(x,y,objgraph[i]);
  1055.           outtext(x+2,y,15,objnames[i]);
  1056.         end;
  1057.       inc(y,2);
  1058.     end;
  1059.   show_objects:= save;
  1060.   mshow;
  1061. end;
  1062.  
  1063. function inside(x1,y1,x2,y2,x,y: integer): boolean;
  1064. begin
  1065.   inside:= (x>=x1) and (x<=x2) and
  1066.            (y>=y1) and (y<=y2);
  1067. end;
  1068.  
  1069. procedure wait_for_mouserelease;
  1070. begin
  1071.   repeat
  1072.     mpos(mouseloc);
  1073.   until mouseloc.buttonstatus=0;
  1074. end;
  1075.  
  1076. procedure bevel(x1,y1,x2,y2,c1,c2,c3: integer);
  1077. begin
  1078.   setfillstyle(1,c1);
  1079.   bar(x1,y1,x2,y2);
  1080.   setcolor(c2);
  1081.   line(x1,y1,x2,y1);
  1082.   line(x1+1,y1+1,x2-1,y1+1);
  1083.   line(x2,y1,x2,y2);
  1084.   line(x2-1,y1,x2-1,y2-1);
  1085.   setcolor(c3);
  1086.   line(x1,y1+1,x1,y2);
  1087.   line(x1+1,y1+2,x1+1,y2);
  1088.   line(x1,y2,x2-1,y2);
  1089.   line(x1+1,y2-1,x2-2,y2-1);
  1090. end;
  1091.  
  1092. function upper(s: string): string;
  1093. var i: integer;
  1094. begin
  1095.   for i:=1 to length(s) do
  1096.     if s[i] in ['a'..'z'] then
  1097.       s[i]:=chr(ord(s[i])-ord('a')+ord('A'));
  1098.   upper:=s;
  1099. end;
  1100.  
  1101.  
  1102.  
  1103. procedure initialize;
  1104. var i: integer;
  1105.     infile: text;
  1106.  
  1107.     path : pathstr;
  1108.     dir  : dirstr;
  1109.     name : namestr;
  1110.     ext  : extstr;
  1111.     filename  : string;
  1112.     hexstr    : string[4];
  1113.     graphstr  : string[4];
  1114.     name20    : string[20];
  1115.     junk      : char;
  1116.     search    : searchrec;
  1117.  
  1118. begin
  1119.   filename:= GAMEPATH + HEADFILENAME + '.*';
  1120.   writeln('MapEdit  Copyright (c) 1992  Bill Kirby');
  1121.   writeln('Version '+version);
  1122.   writeln('searching for ',filename);
  1123.   findfirst(filename,$ff,search);
  1124.   if doserror<>0 then
  1125.     begin
  1126.       writeln('Error opening ',HEADFILENAME,' file.');
  1127.       writeln;
  1128.       writeln('Be sure that you installed MAPEDIT in the directory where');
  1129.       writeln('Wolfenstein 3-D is installed.');
  1130.       halt(0);
  1131.     end
  1132.   else
  1133.     begin
  1134.       filename:= search.name;
  1135.       fsplit(filename,dir,name,ext);
  1136.       HEADFILENAME:= upper(HEADFILENAME+ext);
  1137.       if upper(ext)='.SOD' then
  1138.           LEVELS:=21;
  1139.       if upper(ext)='.WL1' then
  1140.           LEVELS:=10;
  1141.       if (upper(ext)='.WL1') or (upper(ext)='.SOD') then
  1142.         begin
  1143.           GAME_VERSION:=1.0;
  1144.           MAPFILENAME:='MAPTEMP'+ext;
  1145.           filename:=GAMEPATH+'MAPTEMP'+ext;
  1146.           findfirst(filename,$ff,search);
  1147.           if doserror<>0 then
  1148.             begin
  1149.               GAME_VERSION:=1.1;
  1150.               MAPFILENAME:='GAMEMAPS'+ext;
  1151.               filename:=GAMEPATH+'GAMEMAPS'+ext;
  1152.               findfirst(filename,$ff,search);
  1153.               if doserror<>0 then
  1154.                 begin
  1155.                   writeln('Error opening GAMEMAPS or MAPTEMP file.');
  1156.                   halt(0);
  1157.                 end;
  1158.             end;
  1159.         end;
  1160.       if (upper(ext)='.WL3') or (upper(ext)='.WL6') then
  1161.         begin
  1162.           GAME_VERSION:=1.1;
  1163.           if upper(ext)='.WL3' then
  1164.             LEVELS:= 30
  1165.           else
  1166.             LEVELS:= 60;
  1167.           MAPFILENAME:='GAMEMAPS'+ext;
  1168.           filename:=GAMEPATH+'GAMEMAPS'+ext;
  1169.           findfirst(filename,$ff,search);
  1170.           if doserror<>0 then
  1171.             begin
  1172.               writeln('Error opening GAMEMAPS file.');
  1173.               halt(0);
  1174.             end;
  1175.         end;
  1176.     end;
  1177.  
  1178.   for i:= 0 to 511 do
  1179.     begin
  1180.       mapnames[i]:= 'unknown '+hex(i);
  1181.       objnames[i]:= 'unknown '+hex(i);
  1182.       mapgraph[i]:= 'f010';
  1183.       objgraph[i]:= 'f010';
  1184.     end;
  1185.   assign(infile,'mapdata.def');
  1186.   reset(infile);
  1187.   while not eof(infile) do
  1188.     begin
  1189.       readln(infile,hexstr,junk,graphstr,junk,name20);
  1190.       mapnames[str_to_hex(hexstr)]:= name20;
  1191.       mapgraph[str_to_hex(hexstr)]:= graphstr;
  1192.     end;
  1193.   close(infile);
  1194.  
  1195.   assign(infile,'objdata.def');
  1196.   reset(infile);
  1197.   while not eof(infile) do
  1198.     begin
  1199.       readln(infile,hexstr,junk,graphstr,junk,name20);
  1200.       objnames[str_to_hex(hexstr)]:= name20;
  1201.       objgraph[str_to_hex(hexstr)]:= graphstr;
  1202.     end;
  1203.   close(infile);
  1204.  
  1205. end;
  1206.  
  1207. var gd,gm,
  1208.     i,j,x,y   : integer;
  1209.     infile    : text;
  1210.     level     : word;
  1211.     oldx,oldy : integer;
  1212.     done      : boolean;
  1213.     outstr,
  1214.     tempstr   : string;
  1215.  
  1216.     legendpos : integer;
  1217.     legendtype: integer;
  1218.     newj      : integer;
  1219.     currenttype,
  1220.     currentval: integer;
  1221.  
  1222.     oldj,oldi : integer;
  1223.  
  1224.     key       : char;
  1225.     control   : boolean;
  1226.  
  1227.  
  1228. begin
  1229.   clrscr;
  1230.   initialize;
  1231.   directvideo:=false;
  1232.   read_levels;
  1233.  
  1234.   gd:= vga;
  1235.   gm:= vgahi;
  1236.   initgraph(gd,gm,'');
  1237.  
  1238.   settextstyle(0,0,1);
  1239.   mreset(themouse);
  1240.  
  1241.   show_objects:= true;
  1242.   show_floor:= false;
  1243.   stats :=false;
  1244.   copy  :=false;
  1245.   excng :=false;
  1246.   xfer  :=false;
  1247.  
  1248.  
  1249.   x:= port[$3da];
  1250.   port[$3c0]:= 0;
  1251.  
  1252.   setfillstyle(1,7);
  1253.   bar(0,0,64*7+MAP_X+4,64*7+MAP_Y+4);
  1254.   bar(64*7+MAP_X+9,0,639,380);
  1255.   setfillstyle(1,0);
  1256.   bar(2,2,64*7+MAP_X+2,64*7+MAP_Y+2);
  1257.   bar(64*7+MAP_X+11,2,637,380-28);
  1258.   bar(64*7+MAP_X+11,380-25,637,378);
  1259.   setcolor(15);
  1260.   outtextxy(64*7+MAP_X+15,380-16,' MAP  OBJ  UP  DOWN');
  1261.   setfillstyle(1,7);
  1262.   bar(64*7+MAP_X+11+043,380-25,64*7+MAP_X+11+044,378);
  1263.   bar(64*7+MAP_X+11+083,380-25,64*7+MAP_X+11+084,378);
  1264.   bar(64*7+MAP_X+11+113,380-25,64*7+MAP_X+11+114,378);
  1265.  
  1266.   legendpos:= 0;
  1267.   legendtype:= 0;
  1268.   currenttype:= 0;
  1269.   currentval:= 1;
  1270.   setfillstyle(1,0);
  1271.  
  1272.   bar(0,TEXTLOC+10,64*7+MAP_X,479);
  1273.   if currenttype=0 then
  1274.     begin
  1275.       output(0,66,mapgraph[currentval]);
  1276.       outtext(1,66,15,' '+mapnames[currentval]);
  1277.     end
  1278.   else
  1279.     begin
  1280.       output(0,66,objgraph[currentval]);
  1281.       outtext(1,66,15,' '+objnames[currentval]);
  1282.     end;
  1283.  
  1284.   showlegend(legendtype,legendpos,25);
  1285.  
  1286.   x:= port[$3da];
  1287.   port[$3c0]:= 32;
  1288.   mshow;
  1289.   level:=1;
  1290.   done:= false;
  1291.  
  1292.   setfillstyle(1,0);
  1293.   setcolor(15);
  1294.   print_help;
  1295.   print_version;
  1296.  
  1297.   repeat
  1298.     mhide;
  1299.     setfillstyle(1,0);
  1300.     bar(0,TEXTLOC,64*2+MAP_X,TEXTLOC+9);
  1301.     setcolor(14);
  1302.     outtextxy(5,TEXTLOC,maps[level].name);
  1303.     setcolor(15);
  1304.     expand(maps[level].map,levelmap);
  1305.     expand(maps[level].objects,objectmap);
  1306.     display_map;
  1307.     print_stats;
  1308.     mshow;
  1309.     oldx:= 0;
  1310.     oldy:= 0;
  1311.     key:= #0;
  1312.     repeat
  1313.       repeat
  1314.         mpos(mouseloc);
  1315.         x:= mouseloc.column;
  1316.         y:= mouseloc.row;
  1317.       until (oldx<>x) or (oldy<>y) or keypressed or (mouseloc.buttonstatus<>0);
  1318.       oldx:= x;
  1319.       oldy:= y;
  1320.       if (mouseloc.buttonstatus<>0) then
  1321.         begin
  1322.           if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  1323.             begin
  1324.               mhide;
  1325.               repeat
  1326.                 i:= (x - MAP_X) div 7;
  1327.                 j:= (y - MAP_Y) div 7;
  1328.                 if currenttype=0 then
  1329.                   levelmap[i,j]:= currentval
  1330.                 else
  1331.                   objectmap[i,j]:= currentval;
  1332.                 setfillstyle(1,0);
  1333.                 dobar(i*7,j*7,i*7+6,j*7+6);
  1334.                 if show_floor then
  1335.                   output(i,j,mapgraph[levelmap[i,j]])
  1336.                 else
  1337.                   if not (levelmap[i,j] in [$6a..$8f]) then
  1338.                     output(i,j,mapgraph[levelmap[i,j]]);
  1339.                 if show_objects then
  1340.                   output(i,j,objgraph[objectmap[i,j]]);
  1341.                 mpos(mouseloc);
  1342.                 x:= mouseloc.column;
  1343.                 y:= mouseloc.row;
  1344.               until (not inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y)) or
  1345.                     (mouseloc.buttonstatus=0);
  1346.               mshow;
  1347.               print_stats;
  1348.             end;
  1349.           if inside(464,355,506,378,x,y) then
  1350.             begin
  1351.               wait_for_mouserelease;
  1352.               legendpos:= 0;
  1353.               legendtype:= 0;
  1354.               showlegend(legendtype,legendpos,25);
  1355.             end;
  1356.           if inside(509,355,546,378,x,y) then
  1357.             begin
  1358.               wait_for_mouserelease;
  1359.               legendpos:= 0;
  1360.               legendtype:= 1;
  1361.               showlegend(legendtype,legendpos,25);
  1362.             end;
  1363.           if inside(549,355,576,378,x,y) then
  1364.             begin
  1365.               wait_for_mouserelease;
  1366.               dec(legendpos,25);
  1367.               if legendpos<0 then legendpos:= 0;
  1368.               showlegend(legendtype,legendpos,25);
  1369.             end;
  1370.           if inside(579,355,637,378,x,y) then
  1371.             begin
  1372.               wait_for_mouserelease;
  1373.               inc(legendpos,25);
  1374.               if (legendpos+25)>279 then legendpos:= 279-25;
  1375.               showlegend(legendtype,legendpos,25);
  1376.             end;
  1377.         end;
  1378.       if inside(464,2,637,350,x,y) then
  1379.         begin
  1380.           mhide;
  1381.           j:= (y-2) div 14;
  1382.           setcolor(15);
  1383.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1384.           repeat
  1385.             mpos(mouseloc);
  1386.             newj:= (mouseloc.row-2) div 14;
  1387.             if mouseloc.buttonstatus<>0 then
  1388.               begin
  1389.                 currenttype:= legendtype;
  1390.                 currentval:= legendpos+j;
  1391.                 setfillstyle(1,0);
  1392.                 bar(0, TEXTLOC+10, 64*7+MAP_X,479);
  1393.                 if currenttype=0 then
  1394.                   begin
  1395.                     output(0,66,mapgraph[currentval]);
  1396.                     outtext(1,66,15,' '+mapnames[currentval]);
  1397.                   end
  1398.                 else
  1399.                   begin
  1400.                     output(0,66,objgraph[currentval]);
  1401.                     outtext(1,66,15,' '+objnames[currentval]);
  1402.                   end;
  1403.               end;
  1404.           until (newj<>j) or (mouseloc.column<464) or keypressed;
  1405.           setcolor(0);
  1406.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1407.           mshow;
  1408.         end;
  1409.  
  1410.       if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  1411.         begin
  1412.           i:= (x - MAP_X) div 7;
  1413.           j:= (y - MAP_Y) div 7;
  1414.           if (oldj<>j) or (oldi<>i) then
  1415.             begin
  1416.               outstr:= '(';
  1417.               str(i:2,tempstr);
  1418.               outstr:= outstr+tempstr+',';
  1419.               str(j:2,tempstr);
  1420.               outstr:= outstr+tempstr+') MAP: '+mapnames[levelmap[i,j]];
  1421.               setfillstyle(1,0);
  1422.               setcolor(15);
  1423.               bar(188,TEXTLOC,64*7+MAP_X,479);
  1424.               outtextxy(188,TEXTLOC,outstr);
  1425.               outstr:= '        OBJ: '+objnames[objectmap[i,j]];
  1426.               outtextxy(188,TEXTLOC+10,outstr);
  1427.               oldj:= j;
  1428.               oldi:= i;
  1429.             end;
  1430.         end
  1431.       else
  1432.         begin
  1433.           mhide;
  1434.           setfillstyle(1,0);
  1435.       bar(188,TEXTLOC,64*7+MAP_X,479);
  1436.           mshow;
  1437.         end;
  1438.  
  1439.       if keypressed then
  1440.         begin
  1441.           control:= false;
  1442.           key:= readkey;
  1443.           if key=#0 then
  1444.             begin
  1445.               control:= true;
  1446.               key:= readkey;
  1447.             end;
  1448.           if control then
  1449.             case key of
  1450.               'H':
  1451.                 begin
  1452.                   freemem(maps[level].map.data,maps[level].map.size);
  1453.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1454.                   compress(levelmap,maps[level].map);
  1455.                   compress(objectmap,maps[level].objects);
  1456.                   inc(level);
  1457.                 end;
  1458.               'P':
  1459.                 begin
  1460.                   freemem(maps[level].map.data,maps[level].map.size);
  1461.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1462.                   compress(levelmap,maps[level].map);
  1463.                   compress(objectmap,maps[level].objects);
  1464.                   dec(level);
  1465.                 end;
  1466.             end
  1467.           else
  1468.             case key of
  1469.               'q','Q':
  1470.                    begin
  1471.                      done:= true;
  1472.                      freemem(maps[level].map.data,maps[level].map.size);
  1473.                      freemem(maps[level].objects.data,maps[level].objects.size);
  1474.                      compress(levelmap,maps[level].map);
  1475.                      compress(objectmap,maps[level].objects);
  1476.                    end;
  1477.               'c','C': begin
  1478.                          if currenttype = 0 then
  1479.                           begin
  1480.                            clear_level(currentval);
  1481.                           end else
  1482.                           begin
  1483.                            clear_level($8c)  ;
  1484.                           end;
  1485.                        end;
  1486.               'o','O': begin
  1487.                          mhide;
  1488.                          show_objects:= not show_objects;
  1489.                          display_map;
  1490.                          mshow;
  1491.                        end;
  1492.               'f','F': begin
  1493.                          mhide;
  1494.                          show_floor:= not show_floor;
  1495.                          display_map;
  1496.                          if legendtype=0 then
  1497.                            showlegend(legendtype,legendpos,25);
  1498.                          mshow;
  1499.                        end;
  1500.              's','S': begin
  1501.                          stats := not stats;
  1502.                          if stats then print_stats
  1503.                          else print_help;
  1504.                       end;
  1505.              'm','M': begin
  1506.                          copy  := true;
  1507.                          print_help;
  1508.                          copy_level;
  1509.                          if stats then print_stats;
  1510.                       end;
  1511.              'e','E': begin
  1512.                          mhide;
  1513.                          excng := true;
  1514.                          print_help;
  1515.                          if copy then
  1516.                           begin
  1517.                             exchange;
  1518.                             display_map;
  1519.                           end;
  1520.                          excng := false;
  1521.                          print_help;
  1522.                          if stats then print_stats;
  1523.                          mshow;
  1524.                       end;
  1525.              't','T': begin
  1526.                          mhide;
  1527.                          xfer := true;
  1528.                          print_help;
  1529.                          if copy then
  1530.                           begin
  1531.                             paste_level ;
  1532.                             display_map;
  1533.                           end;
  1534.                          xfer := false;
  1535.                          print_help;
  1536.                          delay(200);
  1537.                          if stats then print_stats;
  1538.                          mshow;
  1539.                       end;
  1540.             'r','R': begin
  1541.                         setfillstyle(1,0);
  1542.                         bar(180,TEXTLOC,461,479);
  1543.                         setcolor(15);
  1544.                         outtextxy(180,TEXTLOC,'Reading FLOOR.OUT');
  1545.                         read_floor;
  1546.                         bar(180,TEXTLOC,461,479);
  1547.                         if stats then print_stats;
  1548.                      end;
  1549.             'w','W': begin
  1550.                         setfillstyle(1,0);
  1551.                         bar(180,TEXTLOC,461,479);
  1552.                         setcolor(15);
  1553.                         outtextxy(180,TEXTLOC,'Writing FLOOR.OUT');
  1554.                         write_floor;
  1555.                         bar(180,TEXTLOC,461,479);
  1556.                      end;
  1557.             'v','V': begin
  1558.                         print_version;
  1559.                      end;
  1560.             end;
  1561.         end;
  1562.     until done or (key in ['P','H']);
  1563.     if level=0 then level:=LEVELS;
  1564.     if level=(LEVELS+1) then level:=1;
  1565.   until done;
  1566.  
  1567.   setfillstyle(1,0);
  1568.   bar(0,TEXTLOC,462,479);
  1569.   setcolor(15);
  1570.   outtextxy(0,TEXTLOC,' Save the current levels to disk? (Y/N) ');
  1571.  
  1572.   repeat
  1573.     repeat until keypressed;
  1574.     key:= readkey;
  1575.     if key=#0 then
  1576.       begin
  1577.         key:= readkey;
  1578.         key:= #0;
  1579.       end;
  1580.   until key in ['y','Y','n','N'];
  1581.  
  1582.   if key in ['y','Y'] then write_levels;
  1583.   textmode(co80);
  1584.   writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  1585.   writeln;
  1586.   writeln('   Ver. '+VERSION+' (Dave Huntoon Modification)');
  1587.   writeln;
  1588.   writeln('This program is intended to be for your personal use only.');
  1589.   writeln('Distribution of any modified maps may be construed as a ');
  1590.   writeln('copyright violation by Apogee/ID.');
  1591.   writeln;
  1592. end.
  1593.